(FILECREATED "14-APR-74 19:25:20" GENLISP

     changes to:  ORDERED

     previous date: "13-APR-74 02:56:02")


  (LISPXPRINT (QUOTE GENLISPVARS)
	      T)
  (RPAQQ GENLISPVARS
	 ((FNS GROUPRADS GROUPRADS1 CIELING GROUPBY CARLIST CDRLIST LCARLIST 
	       LCDRLIST DELETE DIFF ORDPAIR MAX MIN ORDERED SUMOF LMASSOC 
	       INTERSECTP LISTOF)))
(DEFINEQ

(GROUPRADS
(LAMBDA (CLOFLISTS) (* Takes a composition list of lists and returns all the
list of all possible selections; with one from each list; for example given
(((A B C) . 2) ((E F) . 3)) returns (A A E E E) (A A E E F) (A A E F E) ...
I.e. All lists with 2 elements from (A B C) and three from (E F) (duplication
allowed)) (COND ((NULL CLOFLISTS) (LIST NIL)) (T (GROUPRADS1 (CAAR CLOFLISTS)
(CDAR CLOFLISTS) (GROUPRADS (CDR CLOFLISTS)))))))

(GROUPRADS1
(LAMBDA (TAKELIST N LISTSDONE) (COND ((ZEROP N) LISTSDONE) (T (for TL1 on
TAKELIST join (for RADS in (GROUPRADS1 TL1 (SUB1 N) LISTSDONE) collect (CONS
(CAR TL1) RADS)))))))

(CIELING
(LAMBDA (X) (FIX (PLUS X .99))))

(GROUPBY
(LAMBDA (FN L) (* FN is a function of one argument; L is a list; returns L
grouped by the values of FN applied to it; e.g. (GROUPBY 'VALENCE L) will
return ((2 %. Atoms with VALENCE 2) (3 %. Atoms with VALENCE 3) ...)) (COND
((NULL L) NIL) (T (PROG (FNX GROUPCDR X) (SETQ GROUPCDR (GROUPBY FN (CDR L)))
(COND ((NULL (SETQ X (LMASSOC (SETQ FNX (APPLY* FN (CAR L))) GROUPCDR NIL)))
(RETURN (CONS (LIST FNX (CAR L)) GROUPCDR))) (T (NCONC1 X (CAR L)) (RETURN
GROUPCDR))))))))

(CARLIST
(LAMBDA (L) (for X in L collect (CAR X))))

(CDRLIST
(LAMBDA (L) (for X in L collect (CDR X))))

(LCARLIST
(LAMBDA (L) (for X in L collect (CARLIST X))))

(LCDRLIST
(LAMBDA (L) (for X in L collect (CDRLIST X))))

(DELETE
(LAMBDA (I L) (COND ((NULL L) (HELP (QUOTE (BAD ARG TO DELETE)))) ((EQ (CAR
L) I) (CDR L)) (T (RPLACD L (DELETE I (CDR L)))))))

(DIFF
(LAMBDA (L1 L2) (for X in L1 when (NOT (MEMBER X L2)) collect X)))

(ORDPAIR
(LAMBDA (X1 X2) (COND ((ORDERED X1 X2) (CONS X1 X2)) (T (CONS X2 X1)))))

(MAX
(LAMBDA (X Y) (COND ((IGREATERP X Y) X) (T Y))))

(MIN
(LAMBDA (X Y) (COND ((IGREATERP X Y) Y) (T X))))

(ORDERED
  [LAMBDA (X Y)
    (COND
      ((NLISTP X)
	(ALPHORDER X Y))
      ((NLISTP Y)
	NIL)
      ((EQUAL (CAR X)
	      (CAR Y))
	(ORDERED (CDR X)
		 (CDR Y)))
      (T (ORDERED (CAR X)
		  (CAR Y])

(SUMOF
(LAMBDA (L) (for X in L sum X)))

(LMASSOC
(LAMBDA (X Y Z) (COND ((SETQ X (COND ((OR (SMALLP X) (LITATOM X)) (ASSOC X
Y)) (T (SASSOC X Y)))) (CDR X)) (T Z))))

(INTERSECTP
(LAMBDA (X Y) (OR (NULL X) (NULL Y) (COND ((LISTP X) (SOME X (FUNCTION (LAMBDA
(X) (INTERSECTP X Y))))) ((LISTP Y) (SOME Y (FUNCTION (LAMBDA (Y) (INTERSECTP
X Y))))) (T (EQ X Y))))))

(LISTOF
(LAMBDA (N ITEM) (for I from 1 to N rcollect ITEM)))
)
STOP